home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Event speed / Reusable units / MyFakeAlert.p < prev   
Encoding:
Text File  |  1996-05-24  |  8.5 KB  |  291 lines  |  [TEXT/PJMM]
  1. {    In-memory item list for dialog with four items:}
  2.  
  3. {    1    "^0^1^2^3" (static text)}
  4. {    2    Button 1}
  5. {    3    Button 2}
  6. {    4    Button 3}
  7.  
  8. {    The caller of FakeAlert passes the four strings that are to be}
  9. {    substituted into the first item, the number of buttons that}
  10. {    should be used, and the titles to put into each button.}
  11. {    A copy of the item list is hacked to use the right number of}
  12. {    buttons.}
  13.  
  14. {    Thanks to Erik Kilk and Jason Haines.  Some of the stuff to do}
  15. {    this is modified from code they wrote.}
  16.  
  17. {    Ported to LightSpeed Pascal 8 January 1987 Owen Hartnett    }
  18. {    Some modifications by Ingemar Ragnemalm 1993:}
  19. {    • Filter function for default button framing and cmd-period support.}
  20. {    • Adding parameters for the new functions}
  21. {    • Simpler calls for common usages.}
  22. {Change sept -95: Centers the dialog.}
  23.  
  24. unit MyFakeAlert;
  25.  
  26. interface
  27. {$IFC UNDEFINED THINK_PASCAL}
  28.     uses
  29.         Types, QuickDraw, Windows, Dialogs, ToolUtils, Events, Controls, {}
  30.         Memory, Sound, OSUtils, MixedMode;
  31. {$ELSEC}
  32. {$SETC GENERATINGPOWERPC:=false }
  33. {$ENDC}
  34.  
  35. {Advanced interface:}
  36.     function MyFakeAlert (s1, s2, s3, s4: Str255; nButtons, defButton, cancelButton: integer; t1, t2, t3: Str255): integer;
  37. {Simple call for displaying a single string:}
  38.     procedure ReportStr (str: str255);
  39. {Simple call for a yes/no question:}
  40.     function QuestionStr (str: str255): boolean;
  41.  
  42. implementation
  43.  
  44. {$IFC UNDEFINED THINK_PASCAL}
  45. {$ELSEC}
  46.     procedure GetDialogItem (theDialog: DialogPtr; itemNo: INTEGER; var itemType: INTEGER; var item: Handle; var box: Rect);
  47.     inline
  48.         $A98D;
  49.     procedure SetControlTitle (theControl: ControlHandle; title: Str255);
  50.     inline
  51.         $A95F;
  52. {$ENDC}
  53.  
  54.     var
  55.         itemList: array[0..32] of integer;
  56.  
  57.         savePort: GrafPtr;
  58.         theDialog: DialogPtr;
  59.         iListHandle: Handle;
  60.         bounds: Rect;
  61.         itemHit: integer;
  62.  
  63.         gDefButton, gCancelButton: integer;
  64.  
  65. {process return and command-period}
  66.     function Filter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
  67.         var
  68.             theChar: Char;
  69.             kind: integer;
  70.             item: Handle;
  71.             box: Rect;
  72.     begin
  73.         if theEvent.what = keyDown then
  74.             begin
  75.                 theChar := Char(BitAnd(theEvent.message, charCodeMask));
  76.                 if BitAnd(theEvent.modifiers, cmdkey) <> 0 then
  77.                     if theChar = '.' then
  78.                         begin
  79.                             itemHit := gCancelButton + 1;
  80. {Måste jag highlighta till keyup?}
  81.  
  82.                             GetDialogItem(theDialog, gCancelButton + 1, kind, item, box);
  83.                             HiliteControl(ControlHandle(item), 1);
  84.  
  85.                             Filter := true;
  86.                             exit(Filter);
  87.                         end;
  88.                 if (theChar = char(13)) or (theChar = char(3)) then
  89.                     begin
  90.                         itemHit := gDefButton + 1;
  91.  
  92.                         GetDialogItem(theDialog, gDefButton + 1, kind, item, box);
  93.                         HiliteControl(ControlHandle(item), 1);
  94.  
  95.                         Filter := true;
  96.                         exit(Filter);
  97.                     end;
  98.             end;
  99.         Filter := false;
  100.     end;
  101.  
  102.  
  103.  
  104.     procedure InitItemList;
  105.  
  106. {This proc performs static initializations on ItemList    }
  107.  
  108.     begin
  109.         itemList[0] := 3;                    { max number of items - 1 }
  110.         itemList[1] := 0;                    {    statText item}
  111.                                         { reserve a long for item handle }
  112.         itemList[2] := 0;                    { display rectangle }
  113. {(bounds, 115, 80, 355, 220)}
  114.         itemList[3] := 10; {top = 10}
  115.         itemList[4] := 27; {left = 27}
  116. {if nButtons > 2 then itemList[5] := 61 else}
  117.         itemList[5] := 90; {bot = 61}
  118.         itemList[6] := 225; {right = 225}
  119.         itemList[7] := $8808;    { 8 + 128 = statText (disabled), title 8 bytes long }
  120.         itemList[8] := $5e30;    { ^0^1^2^3 }
  121.         itemList[9] := $5e31;
  122.         itemList[10] := $5e32;
  123.         itemList[11] := $5e33;
  124. {    first button}
  125.         itemList[12] := 0;                { reserve a long for item handle }
  126.         itemList[13] := 0;
  127.         itemList[14] := 104;                { display rectangle }
  128.         itemList[15] := 140;
  129.         itemList[16] := 124;
  130.         itemList[17] := 210;
  131.         itemList[18] := $400;        { 4 = pushButton, title is 0 bytes long}
  132. {    second button}
  133.         itemList[19] := 0;                { reserve a long for item handle }
  134.         itemList[20] := 0;
  135.         itemList[21] := 104;                { display rectangle }
  136.         itemList[22] := 30;
  137.         itemList[23] := 124;
  138.         itemList[24] := 100;
  139.         itemList[25] := $400;        { 4 = pushButton, title is 0 bytes long}
  140. {    third button}
  141.         itemList[26] := 0;                { reserve a long for item handle }
  142.         itemList[27] := 0;
  143.         itemList[28] := 72;                { display rectangle }
  144.         itemList[29] := 30;
  145.         itemList[30] := 92;
  146.         itemList[31] := 100;
  147.         itemList[32] := $400;        { 4 = pushButton, title is 0 bytes long}
  148.     end;
  149.  
  150. {    Set dialog button title and draw bold outline if makeBold true.}
  151. {    This must be done after the window is shown or else the bold}
  152. {    outline won't show up (which is probably the wrong way to do it).}
  153.  
  154.     procedure SetDControl (theDialog: DialogPtr; itemNo: integer; title: Str255; makeBold: Boolean);
  155.         var
  156.             itemHandle: Handle;
  157.             itemType: integer;
  158.             itemRect: Rect;
  159.             pState: PenState;
  160.  
  161.     begin
  162.         GetDialogItem(theDialog, itemNo, itemType, itemHandle, itemRect);
  163.         SetControlTitle(ControlHandle(itemHandle), title);
  164.         if makeBold then
  165.             begin
  166.                 GetPenState(pState);
  167.                 PenNormal;
  168.                 PenSize(3, 3);
  169.                 InsetRect(itemRect, -4, -4);
  170.                 FrameRoundRect(itemRect, 16, 16);
  171.                 SetPenState(pState);
  172.             end;
  173.     end;
  174.  
  175. {    Fake an alert, using an in-memory window and item list.}
  176. {    The message to be presented is constructed from the first}
  177. {    four arguments.  nButtons is the number of buttons to use,}
  178. {    defButton is the default button, the next three args are}
  179. {    the titles to put into the buttons.  The return value is}
  180. {    the button number (1..nButtons).  This must be interpreted}
  181. {    by the caller, since the buttons may be given arbitrary}
  182. {    titles.}
  183.  
  184. {    nButtons should be between 1 and 3, inclusive.}
  185. {    defButton should be between 1 and nButtons, inclusive.}
  186.  
  187.     function MyFakeAlert (s1, s2, s3, s4: Str255; nButtons, defButton, cancelButton: integer; t1, t2, t3: Str255): integer;
  188.         var
  189.             savePort: GrafPtr;
  190.             theDialog: DialogPtr;
  191.             iListHandle: Handle;
  192.             bounds: Rect;
  193.             itemHit: integer;
  194. {$IFC GENERATINGPOWERPC }
  195.             filterProc: ProcPtr;
  196. {$ENDC}
  197.  
  198.         procedure FakeBarf;
  199.         begin
  200.             SysBeep(1);
  201.             exit(MyFakeAlert);
  202.         end;
  203.  
  204.     begin
  205.         gDefButton := defbutton;
  206.         gCancelButton := cancelbutton;
  207.  
  208.         InitItemList;
  209.         if nButtons > 2 then
  210.             itemList[5] := itemList[28] - 3;    {Bottom edge of text must not overlap button}
  211.  
  212.         InitCursor;
  213.         GetPort(savePort);
  214.         iListHandle := NewHandle(longint(512));
  215.         if iListHandle = nil then
  216.             FakeBarf;
  217.         HLock(iListHandle);
  218.         itemList[0] := nButtons;                                { = number items - 1 }
  219.         BlockMove(@itemList[0], iListHandle^, longint(512));
  220.         SetRect(bounds, 115, 80, 355, 220);
  221.  
  222. {Center!}
  223.         OffsetRect(bounds, -bounds.left, -bounds.top);
  224. {$IFC UNDEFINED THINK_PASCAL}
  225.         OffsetRect(bounds, -(bounds.right - bounds.left) div 2 + (qd.screenBits.Bounds.right - qd.screenBits.bounds.left) div 2, 0);
  226.         OffsetRect(bounds, 0, -(bounds.bottom - bounds.top) div 2 + (qd.screenBits.Bounds.bottom - qd.screenBits.bounds.top - 20) div 2 + 20);
  227. {$ELSEC}
  228.         OffsetRect(bounds, -(bounds.right - bounds.left) div 2 + (screenBits.Bounds.right - screenBits.bounds.left) div 2, 0);
  229.         OffsetRect(bounds, 0, -(bounds.bottom - bounds.top) div 2 + (screenBits.Bounds.bottom - screenBits.bounds.top - 20) div 2 + 20);
  230. {$ENDC}
  231.  
  232.         theDialog := NewDialog(nil, bounds, '', false, dBoxProc, WindowPtr(-1), false, longint(0), iListHandle);
  233.         if theDialog = nil then
  234.             FakeBarf;
  235.         ParamText(s1, s2, s3, s4);                            { construct message }
  236.         SetPort(theDialog);
  237.         ShowWindow(theDialog);
  238.  
  239.         case nButtons of                { set button titles }
  240.             3: 
  241.                 begin
  242.                     SetDControl(theDialog, 4, t3, defButton = 3);
  243.                     SetDControl(theDialog, 3, t2, defButton = 2);
  244.                     SetDControl(theDialog, 2, t1, defButton = 1);
  245.                 end;
  246.             2: 
  247.                 begin
  248.                     SetDControl(theDialog, 3, t2, defButton = 2);
  249.                     SetDControl(theDialog, 2, t1, defButton = 1);
  250.                 end;
  251.             1: 
  252.                 SetDControl(theDialog, 2, t1, defButton = 1);
  253.         end;
  254.  
  255. {    ModalDialog returns 1 if return/enter hit, which, since}
  256. {    the statText item is first, can be unambiguously}
  257. {    interpreted as "choose default".}
  258.  
  259. {$IFC GENERATINGPOWERPC }
  260.         filterProc := NewRoutineDescriptor(@Filter, uppModalFilterProcInfo, GetCurrentISA);
  261.         ModalDialog(filterProc, itemHit);
  262. {$ELSEC}
  263.         ModalDialog(@Filter, itemHit);
  264. {$ENDC}
  265.  
  266.         if itemHit = 1 then
  267.             itemHit := defButton
  268.         else
  269.             itemHit := itemHit - 1;
  270.         HUnlock(iListHandle);
  271.         DisposeDialog(theDialog);
  272.         SetPort(savePort);
  273.         MyFakeAlert := itemHit;
  274.     end;
  275.  
  276. {Single text message:}
  277.     procedure ReportStr (str: str255);
  278.         var
  279.             itemHit: integer;
  280.     begin
  281.         itemHit := MyFakeAlert(str, '', '', '', 1, 1, 0, 'OK', '', '');
  282. {itemHit := SATFakeAlert(str, '', '', '', 1, 1, 0, SATokStr, '', '');}
  283.     end;
  284. {A yes/no question:}
  285.     function QuestionStr (str: str255): boolean;
  286.     begin
  287.         QuestionStr := 1 = MyFakeAlert(str, '', '', '', 2, 1, 2, 'Yes', 'No', '');
  288. {QuestionStr := 1 = SATFakeAlert(str, '', '', '', 2, 1, 2, SATyesStr, SATnoStr, '');}
  289.     end;
  290.  
  291. end.